home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue25 / compress / COMPRESS.ZIP / BLOBDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-07-09  |  6.2 KB  |  165 lines
  1. (* BLOBDEMO.PAS for TCompress V3.0 (only comments changed from V2.5)
  2.  
  3.    This unit provides example code for two things:
  4.    1. On-the-fly creation of compressed blob fields
  5.    2. Writing and reading of any kind of data (e.g. arrays, AVI, WAV etc)
  6.       to/from a compressed blob field.
  7.  
  8.    Before running the program, you need to use the Database Desktop to create
  9.    a table called BLOB.DB in the DBDEMOS alias which contains a 'Name' field (A10)
  10.    and a 'Data' field (B0). For a full test, you'd also want to add routines
  11.    to put meaningful data into the OurData array, and display it
  12.    before/after blob reads.  We're just compressing a bunch of zeros...
  13.  
  14. *)
  15. unit Blobdemo;
  16.  
  17. interface
  18.  
  19. uses
  20.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  21.   Forms, Dialogs, StdCtrls, Grids, DBGrids, ExtCtrls, DBCtrls, DB, DBTables,
  22.   Compress, CompCtrl;  { <--- CompCtrl for the TCBlobField/TCBlobstream types }
  23.  
  24. type
  25.   TForm1 = class(TForm)
  26.     Table1: TTable;
  27.     DataSource1: TDataSource;
  28.     DBGrid1: TDBGrid;
  29.     SaveArray: TButton;
  30.     LoadArray: TButton;
  31.     Compress1: TCompress;
  32.     Table1Name: TStringField;
  33.     Label1: TLabel;
  34.     procedure FormCreate(Sender: TObject);
  35.     procedure FormDestroy(Sender: TObject);
  36.     procedure SaveArrayClick(Sender: TObject);
  37.     procedure LoadArrayClick(Sender: TObject);
  38.   private
  39.     { Private declarations }
  40.   public
  41.     { Public declarations }
  42.   end;
  43.  
  44. var
  45.   Form1: TForm1;
  46.   TestCount: Smallint; { just for making field names }
  47.  
  48. implementation
  49.  
  50. {$R *.DFM}
  51.  
  52. var  BlobDataField:TCBlobField;  { compressed field we'll set up at runtime }
  53.      OurData: Array[1..4000] of Smallint; { Data to go to/from the field }
  54.  
  55. { Here, we create our compressed field BEFORE opening the table. Note that
  56.   the field ('Data' in this case) should *not* appear in the list of fields
  57.   you see when you double-click on the Grid or on Table1. If it is, remove it.
  58.   If the list is blank, add whatever you need, but NOT 'Data'.            }
  59.  
  60. procedure TForm1.FormCreate(Sender: TObject);
  61. begin
  62.   BlobDataField := TCBlobField.Create(Self);
  63.   BlobDataField.CompressSource := Compress1; { Our TCompress component     }
  64.   BlobDataField.CompressionMethod := coRLE; { RLE compression, for example }
  65.   BlobDataField.FieldName:='Data'; { or whatever you call it in the table }
  66.   BlobDataField.Size := 0;         { The # of bytes stored WITHIN the table }
  67.   BlobDataField.DataSet := Table1;
  68.   try
  69.     Table1.Open;  { Note: In Delphi 2.0+, we've edited our grid (double-click) to ensure
  70.                   that the new field will NOT be added to the grid. This is
  71.                   because the V2.0 grids try to detail with (and display) it as
  72.                   a TBlobfield instead of a TCBlobfield, which causes spurious
  73.                    "Blob not open" errors. Please adopt the same tactic if you
  74.                    are working with custom blob fields like this in Delphi 2.
  75.                  }
  76.   except
  77.  
  78. (* This code here would be FINE except that for a Delphi VCL/BDE bug,
  79.    -- telling it to create a table with a ftBlob field size zero
  80.    (something perfectly possible in Database Desktop) results
  81.    in a table with a ftBlob ('B') field size 1. This is a baaad
  82.    thing and doesn't work for our purposes. So alas, we have to ask you
  83.    to create the demo table manually. Sorry about that. It's a pain.
  84.  
  85. UPDATE April 97: This commented-out code should now work for Delphi 1, but
  86. only by exploiting another bug which arises from setting TableType to ttDefault
  87. instead of ttParadox. However, the GOOD news is that there is a VCL patch
  88. available to remove the original bug -- for all Delphi versions. If you want
  89. to know how to create a table with a 0-length Blob field in it, see
  90. http://www.spis.co.nz/blobfix.htm
  91.  
  92.     with Table1 do
  93.     begin
  94.       DatabaseName := 'DBDEMOS';
  95.       TableName := 'BLOB.DB';
  96.       TableType := ttDefault; { if ttParadox, Delphi 1 will misbehave again }
  97.       with FieldDefs do
  98.       begin
  99.         Clear;
  100.         Add('Name', ftString, 10,True);
  101.         Add('Data', ftBlob, 0,False);  { bzzzt -- wrong -- makes size 1, dammit! }
  102.       end;
  103.       IndexDefs.Clear;
  104.       CreateTable;
  105.       FieldDefs.Clear;
  106.       temptable.free;
  107.       Table1.Open; { open should work this time... but won't, due to above "spec" }
  108.     end;
  109. *)      { so instead, we: }
  110.      showMessage('Please create a table called BLOB.DB in the'+#13+
  111.                  'DBDEMOS alias, according to the specs in BLOBDEMO.PAS.'+#13+#13+
  112.                  'THEN run this program again.');
  113.  
  114.   end;
  115. end;
  116.  
  117.  
  118.  
  119. { After all that, here's the enjoyable bits.... }
  120.  
  121. { How to write/compress our array data to the blob }
  122. procedure TForm1.SaveArrayClick(Sender: TObject);
  123. var cbs: TCBlobstream;
  124. begin
  125.      { this is cosmetic stuff }
  126.   Inc(TestCount);
  127.   Table1.append; { put a new record in, what the heck (or you could just Edit) }
  128.   Table1.FieldByName('Name').asstring := 'Test '+IntToStr(TestCount);
  129.  
  130.     { this is the IMPORTANT bit }
  131.   cbs:= TCBlobstream.create(BlobDataField,bmWrite); { will save our data to it }
  132.   cbs.writeBuffer(OurData,sizeof(OurData));         { standard stream method   }
  133.   showmessage('Compressed and wrote '+IntToStr(cbs.size)+' bytes');
  134.   cbs.free;    { done! (compression occurs just here...) }
  135.   Table1.Post;
  136. end;
  137. { Note: If the data was coming from a file or another object, you could use the
  138.         CopyFrom method from the applicable filestream/memorystream/blobstream }
  139.  
  140.  
  141. { How to read/expand our data (of whatever nature) back into our array }
  142. procedure TForm1.LoadArrayClick(Sender: TObject);
  143. var cbs: TCBlobstream;
  144.     bs: TBlobStream;
  145. begin
  146.   cbs:= TCBlobstream.create(BlobDataField,bmRead); { will read our data from it }
  147.   cbs.readBuffer(OurData,sizeof(OurData));         { standard stream method   }
  148.   showmessage('Expanded and read '+IntToStr(cbs.size)+' bytes');
  149.   cbs.free;
  150.  
  151.   { Oh, and by the way... }
  152.   bs := TBlobStream.Create(BlobDataField,bmread); { a handle on our RAW (compressed) data }
  153.   showmessage('By the way, that was stored in only '+IntToStr(bs.size)+' bytes');
  154.   bs.free;
  155. end;
  156.  
  157. { Cleanup code }
  158. procedure TForm1.FormDestroy(Sender: TObject);
  159. begin
  160.   if Table1.Active then Table1.close;
  161.   BlobDataField.free;
  162. end;
  163.  
  164. end.
  165.